home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0986.arc / AIEYE.LTG < prev    next >
Text File  |  1986-08-21  |  9KB  |  203 lines
  1.                    Listing 1:  Unify in Common Lisp
  2.  
  3. è;;; Unify a pattern list P with an example list E, returning bindings B.
  4. ;;; Either P or E may contain pattern variables.
  5.  
  6. (DEFUN UNIFY (P E &OPTIONAL (B '(NIL)))
  7.   (COND ((NULL B) NIL)                     ;Boundary case--fail if nil bindings
  8.         ((OR (EQUAL P '_) (EQUAL E '_)     ;If P or E is anonymous var '_' or
  9.              (EQUAL P E)) B)               ;  if P = E, succeed w/ B unchanged
  10.         ((VAR? P) (BIND (NAME P) E B))     ;If P is a var, bind it and succeed
  11.         ((VAR? E) (BIND (NAME E) P B))     ;If E is a var, bind it and succeed
  12.         ((OR (ATOM P) (ATOM E)) NIL)       ;If P or E is an atom, must fail
  13.         ((UNIFY (CDR P) (CDR E)            ;Else they are lists, unify tails
  14.          (UNIFY (CAR P) (CAR E) B)))))     ; with bindings from unifying heads
  15.  
  16. ;;; Check if the argument, ITEM, is a variable of the form '(= varname)
  17.  
  18. (DEFUN VAR? (ITEM)
  19.   (AND (CONSP ITEM) (EQ (CAR ITEM) '=)))
  20.  
  21. ;;; Return the name of a variable of the form '(= varname)
  22.  
  23. (DEFUN NAME (ITEM) (CADR ITEM))
  24.  
  25. ;;; Bind a variable called NAME to a VALUE and return the updated BINDINGS
  26. ;;; or NIL if NAME is already bound to a different value.  Note that if
  27. ;;; NAME is already bound, BIND returns the result of recursively
  28. ;;; unifying the variable with the previously stored value.
  29.  
  30. (DEFUN BIND (NAME VALUE BINDINGS)
  31.   (LET ((BINDING (ASSOC NAME BINDINGS)))             ;Look up old binding
  32.         (COND ((NULL BINDING)                        ;If there was none,
  33.                (CONS (LIST NAME VALUE) BINDINGS))    ; add one now using VALUE
  34.           ((UNIFY (CADR BINDING) VALUE BINDINGS))))) ;Else unify w/ bound value
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.                    Listing 2: AIML -- AI Matching Language
  42.  
  43.  
  44. % Conventions for variable names:
  45. %   P, E:   Pattern and Example, both lists or nested lists.
  46. %   PH, PT: Pattern Head, Pattern Tail
  47. %   EH, ET: Example Head, Example Tail
  48. %   B:      Bindings finally resulting from a match.
  49. %   M:      Match value:  head elements of example that were matched.
  50. %   R:      Remainder: tail elements of example that weren't matched.
  51. % Variables with integer suffixes like B1 and M2 are intermediates Bindings,
  52. % Match values, and so on resulting from nested calls to match.
  53. %
  54. % NOTE: You'll need the bind, append, and member predicates from May's column.
  55. %
  56. % NOTE: If your Prolog doesn't like Match's use of *, ++, ~, etc. for pattern
  57. %       operators, try quoting them, redefining them using the op orè%       equivalent predicate, or change them to other symbols or alpha names.
  58.  
  59. [1]   % Defined for convenience: match pattern (P) to example (E).
  60. match(P, E) :- match(P, E, _, [], [], _).
  61.  
  62. [2]   % Defined for convenience:  match pattern (P) to example (E)
  63.       % under bindings (B).
  64. match(P, E, B) :- match(P, E, _, [], [], B).
  65.  
  66. [3]   % Null pattern returns [] as match value and example (E) as
  67.       % match remainder.
  68. match([], E, [], E, B, B).
  69.  
  70. [4]   % If pattern and example heads (EH) match, try matching tails (PT, ET)
  71.       % and then add EH to the resulting match value (M).  The remainder (R)
  72.       % from matching tails will be the remainder for the whole operation.
  73. match([EH | PT], [EH | ET], [EH | M], R, B1, B) :-
  74.       atomic(EH),                       % Rule doesn't apply if heads are lists
  75.       match(PT, ET, M, R, B1, B).       % (in that case, the last rule applies)
  76.  
  77. [5a]  % ? matches one element (EH), so try matching PT to ET.
  78. match([? | PT], [EH | ET], [EH | M], R, B1, B) :-
  79.       match(PT, ET, M, R, B1, B).       % Match the pattern and example tails
  80.  
  81. [5b]  % ? can also match zero elements, so try matching PT to whole of E.
  82. match([? | PT], E, M, R, B1, B) :-
  83.       match(PT, E, M, R, B1, B).        % Match PT to whole example
  84.  
  85. [6]   % - operator matches exactly one element, like first rule for ?.
  86. match([- | PT], [EH | ET], [EH | M], R, B1, B) :-
  87.       match(PT, ET, M, R, B1 ,B).
  88.  
  89. [7]   % * operator matches zero or more elements.
  90. match([* | PT], E, M, R, B1, B) :-
  91.       append(EH, ET, E),                % Carve head sublist (EH) from E
  92.       match(PT, ET, M1, R, B1, B),      % Match what's left--ET
  93.       append(EH, M1, M).                % Add EH to resulting match value M1
  94.  
  95. [8]   % + operator matches 1 or more, so just replace it with -,*
  96. match([+ | PT], E, M, R, B1, B) :-
  97.       match([-, * | PT], E, M, R, B1, B).
  98.  
  99. [9]   % [=, N | PH] binds N to the result of matching PH to E, assuming the
  100.       % rest of the pattern (PT) matches the remainder (R) of from this match.
  101. match([[=, N | PH] | PT], E, M, R, B1, B) :-
  102.       match(PH, E, M1, R1, B1, B2),     % Match head part of pattern
  103.       bind([N | M1], B2, B3),           % Bind match value M1 to var name N
  104.       match(PT, R1, M2, R, B3, B),      % Match rest of pattern PT to
  105.       append(M1, M2, M).                %   remainder R from first match
  106.                                         %   and append the PH & PT match values
  107.  
  108. [10]  % [~ | PH] succeeds if PH doesn't match any head sublist of E.
  109. match([[~ | PH] | PT], E, M, R, B1, B) :-
  110.       not(match(PH, E, _, _, B1, _)),   % See if PH matches, then negate
  111.       match(PT, E, M, R, B1 ,B).        % Match rest of pattern PT to example Eè
  112. [11a] % [?? | PH] succeeds of PH matches a head sublist of E zero or one times.
  113.       % First rule:  check for matching PH zero times.
  114. match([[?? | PH] | PT], E, M, R, B1, B) :-
  115.       match(PT, E, M, R, B1, B).        % Discard operator to match zero times
  116.  
  117. [11b] % Second rule for ??:  Check for matching PH once.
  118. match([[?? | PH] | PT], E, M, R, B1, B) :-
  119.       match(PH, E, M1, R1, B1, B2),     % Match PH once
  120.       match(PT, R1, M2, R, B2, B),      % Match PT to remainder from 1st match
  121.       append(M1, M2, M).                % And combine the two match values
  122.  
  123. [12a] % [++ | PH] succeeds of PH matches a head sublist of E one or more times.
  124.       % First rule:  check for a single match
  125. match([[++ | PH] | PT], E, M, R, B1, B) :-
  126.       match(PH, E, M1, R1, B1, B2),     % Match PH once
  127.       match(PT, R1, M2, R, B2, B),      % Match PT to remainder from 1st match
  128.       append(M1, M2, M).                % And combine the two match values
  129.  
  130. [12b] % Second rule for ++:  Check for more than one match.
  131. match([[++ | PH] | PT], E, M, R, B1, B) :-
  132.       match(PH, E, M1, R1, B1, B2),              % Match PH once
  133.       match([[++ | PH] | PT], R1, M2, R, B2, B), % Then see if it matches again
  134.       append(M1, M2, M).
  135.  
  136. [13]  % [# | PL] matches if any member of the list of patterns PL matches.
  137. match([[# | PL] | PT], E, M, R, B1, B) :-
  138.       member(PH, PL),                   % Get a member from the pattern list
  139.       match(PH, E, M1, R1, B1, B2),     % Try matching it
  140.       match(PT, R1, M2, R, B2, B),      % Match remainder R1 to rest of pattern
  141.       append(M1, M2, M).                % And append the two match values
  142.  
  143. [14]  % [@, PN] matches the pattern named PN to E, then matches the resulting
  144.       % remainder (R) to the rest of the pattern (PT).
  145. match([[@, PN] | PT], E, M, R, B1, B) :-
  146.       pattern(PN, PH),                  % Find pattern PH for pattern name PN
  147.       append(PH, PT, P),                % Add PH to rest of pattern
  148.       match(P, E, M, R, B1, B).         % And proceed with match
  149.  
  150. [15]  % [:, F | PH] matches the pattern PH to E, then calls the function F with
  151.       % the resulting match value (M) as an argument, and finally
  152. match([[: , F | PH] | PT], E, M, R, B1, B) :-
  153.       match(PH, E, M1, R1, B1, B2),     % Match head part of pattern
  154.       Pred =.. [F , M1],                % Make match value M1 into args for
  155.       call(Pred),                       %  the functor F and call it
  156.       match(PT, R1, M, R, B2, B).       % Match rest of pattern PT to remainder
  157.                                         %  R1 from first match
  158.  
  159. [16]  % [/, N | PH] returns as its match value the named structure N(M),
  160.       % where M is the match value from matching PH to the example E.
  161. match([[/, N | PH] | PT], E, [M | M2], R, B1, B) :-
  162.       match(PH, E, M1, R1, B1, B2),     % Match head part of pattern
  163.       match(PT, R1, M2, R, B2, B),      % Match tail part of pattern
  164.       M =.. [N | M1].                   % Make the structured match value
  165. è[17]  % [\ | PH] causes PH to return no match value (\ eats the match value).
  166. match([[\ | PH] | PT], E, M, R, B1, B) :-
  167.       match(PH, E, _, R1, B1, B2),      % Match PH and throw away match value
  168.       match(PT, R1, M, R, B2, B).       % Final match M value is due to PT only
  169.  
  170. [18]  % If we get here, pattern head isn't a pattern op, match recursivley.
  171. match([PH | PT], [EH | ET], [M1 | M2], R, B1, B) :-
  172.       match(PH, EH, M1, [], B1, B2),    % See if heads match with no remainder
  173.       match(PT, ET, M2, R, B2, B).      % If so, match tails
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.              Listing 3:  Lisp/Scheme Benchmarks (Scheme version)
  182.  
  183. ;;; T1: CONS performance
  184.  
  185. (DEFINE T1
  186.    (LAMBDA (N)
  187.      (IF (< N 2) '(1) (CONS N (T1 (- N 1))) )))
  188.  
  189. ;;; T2: Integer math performance
  190.  
  191. (DEFINE T2
  192.    (LAMBDA (N)
  193.       (IF (< N 2) 1  (+ (T2 (- N 1)) (T2 (- N 2))) )))
  194.  
  195. ;;; T3: Iteration performance
  196.  
  197. (DEFINE T3
  198.    (LAMBDA (N)
  199.      (DO ((I N (- I 1)))
  200.          ((= I 0)) )))
  201.  
  202.  
  203.